Ejemplo tomado:

# Machine Learning
library(tidymodels)
## Registered S3 method overwritten by 'tune':
##   method                   from   
##   required_pkgs.model_spec parsnip
## ── Attaching packages ────────────────────────────────────── tidymodels 0.1.4 ──
## ✓ broom        0.7.10     ✓ recipes      0.1.17
## ✓ dials        0.0.10     ✓ rsample      0.1.1 
## ✓ dplyr        1.0.7      ✓ tibble       3.1.6 
## ✓ ggplot2      3.3.5      ✓ tidyr        1.1.4 
## ✓ infer        1.0.0      ✓ tune         0.1.6 
## ✓ modeldata    0.1.1      ✓ workflows    0.2.4 
## ✓ parsnip      0.1.7      ✓ workflowsets 0.1.0 
## ✓ purrr        0.3.4      ✓ yardstick    0.0.9
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## x purrr::discard() masks scales::discard()
## x dplyr::filter()  masks stats::filter()
## x dplyr::lag()     masks stats::lag()
## x recipes::step()  masks stats::step()
## • Use suppressPackageStartupMessages() to eliminate package startup messages
library(modeltime)
library(modeltime.ensemble)
## Loading required package: modeltime.resample
library(modeltime.resample)

# Time Series
library(timetk)

# Core
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ readr   2.1.1     ✓ forcats 0.5.1
## ✓ stringr 1.4.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x readr::col_factor() masks scales::col_factor()
## x purrr::discard()    masks scales::discard()
## x dplyr::filter()     masks stats::filter()
## x stringr::fixed()    masks recipes::fixed()
## x dplyr::lag()        masks stats::lag()
## x readr::spec()       masks yardstick::spec()

DATA

walmart_sales_weekly
## # A tibble: 1,001 × 17
##    id    Store  Dept Date       Weekly_Sales IsHoliday Type    Size Temperature
##    <fct> <dbl> <dbl> <date>            <dbl> <lgl>     <chr>  <dbl>       <dbl>
##  1 1_1       1     1 2010-02-05       24924. FALSE     A     151315        42.3
##  2 1_1       1     1 2010-02-12       46039. TRUE      A     151315        38.5
##  3 1_1       1     1 2010-02-19       41596. FALSE     A     151315        39.9
##  4 1_1       1     1 2010-02-26       19404. FALSE     A     151315        46.6
##  5 1_1       1     1 2010-03-05       21828. FALSE     A     151315        46.5
##  6 1_1       1     1 2010-03-12       21043. FALSE     A     151315        57.8
##  7 1_1       1     1 2010-03-19       22137. FALSE     A     151315        54.6
##  8 1_1       1     1 2010-03-26       26229. FALSE     A     151315        51.4
##  9 1_1       1     1 2010-04-02       57258. FALSE     A     151315        62.3
## 10 1_1       1     1 2010-04-09       42961. FALSE     A     151315        65.9
## # … with 991 more rows, and 8 more variables: Fuel_Price <dbl>,
## #   MarkDown1 <dbl>, MarkDown2 <dbl>, MarkDown3 <dbl>, MarkDown4 <dbl>,
## #   MarkDown5 <dbl>, CPI <dbl>, Unemployment <dbl>
walmart_sales_weekly%>%
  group_by(id)%>%
  plot_time_series(Date,Weekly_Sales,.facet_ncol = 3, .interactive = F)

DATA PREPARATION

FORECAST_HORIZON <- 52

Full = Training + Forecast Dataset

full_data_tbl <- walmart_sales_weekly%>%
  select(id,Date,Weekly_Sales)%>%
  
  ## Apply Group-Wise Time Series Manipulations
  group_by(id)%>%
  future_frame(
    .date_var = Date,
    .length_out = FORECAST_HORIZON,
    .bind_data = T
  )%>%
  ungroup()%>%
  
  # Consolidate IDs
  mutate(id=fct_drop(id))

Training Data

data_prepared_tbl <- full_data_tbl%>%
  filter(!is.na(Weekly_Sales))
  
data_prepared_tbl%>%
  group_by(id)%>%
  tk_summary_diagnostics()
## tk_augment_timeseries_signature(): Using the following .date_var variable: Date
## # A tibble: 7 × 13
## # Groups:   id [7]
##   id    n.obs start      end        units scale tzone diff.minimum diff.q1
##   <fct> <int> <date>     <date>     <chr> <chr> <chr>        <dbl>   <dbl>
## 1 1_1     143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## 2 1_3     143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## 3 1_8     143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## 4 1_13    143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## 5 1_38    143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## 6 1_93    143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## 7 1_95    143 2010-02-05 2012-10-26 days  week  UTC         604800  604800
## # … with 4 more variables: diff.median <dbl>, diff.mean <dbl>, diff.q3 <dbl>,
## #   diff.maximum <dbl>

Future Data Forecast

future_tbl <- full_data_tbl%>%
  filter(is.na(Weekly_Sales))

SPLITTING

splits <- data_prepared_tbl%>%
  arrange(id,Date)%>%
  time_series_split(
    data_var=Date,
    assess = FORECAST_HORIZON,
    cumulative = T
  )
## Using date_var: Date
## Data is not ordered by the 'date_var'. Resamples will be arranged by `Date`.
## Overlapping Timestamps Detected. Processing overlapping time series together using sliding windows.
splits
## <Analysis/Assess/Total>
## <637/364/1001>
# Testing Count
84/7
## [1] 12
# Training Count
917/7
## [1] 131

PREPROCESOR

recipe_spec_1 <- recipe(Weekly_Sales~., training(splits))%>%
  step_timeseries_signature(Date)%>%
  ## Elimina las columnas o atributos que no aportan
  step_rm(matches("(.iso$)|(.xts)|(day)|(hour)|(minute)|(second)|(am.pm)")) %>%
  step_normalize(Date_index.num,Date_year)%>%
  step_mutate(Date_week = factor(Date_week,ordered = T))%>%
  step_dummy(all_nominal(),one_hot = T)

recipe_spec_1 %>% prep() %>% juice() %>% glimpse()
## Rows: 637
## Columns: 83
## $ Date              <date> 2010-02-05, 2010-02-05, 2010-02-05, 2010-02-05, 201…
## $ Weekly_Sales      <dbl> 24924.50, 13740.12, 40129.01, 41969.29, 115564.35, 6…
## $ Date_index.num    <dbl> -1.711776, -1.711776, -1.711776, -1.711776, -1.71177…
## $ Date_year         <dbl> -0.9457415, -0.9457415, -0.9457415, -0.9457415, -0.9…
## $ Date_half         <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Date_quarter      <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Date_month        <int> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2…
## $ Date_mweek        <int> 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3…
## $ Date_week2        <int> 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0…
## $ Date_week3        <int> 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2…
## $ Date_week4        <int> 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0…
## $ id_X1_1           <dbl> 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0…
## $ id_X1_3           <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0…
## $ id_X1_8           <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0…
## $ id_X1_13          <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1…
## $ id_X1_38          <dbl> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0…
## $ id_X1_93          <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0…
## $ id_X1_95          <dbl> 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0…
## $ Date_month.lbl_01 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_02 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Date_month.lbl_03 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_04 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_05 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_06 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_07 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_08 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_09 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_10 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_11 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_12 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_01      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_02      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_03      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_04      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_05      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_06      <dbl> 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_07      <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0…
## $ Date_week_08      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1…
## $ Date_week_09      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_10      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_11      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_12      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_13      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_14      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_15      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_16      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_17      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_18      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_19      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_20      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_21      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_22      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_23      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_24      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_25      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_26      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_27      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_28      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_29      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_30      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_31      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_32      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_33      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_34      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_35      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_36      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_37      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_38      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_39      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_40      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_41      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_42      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_43      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_44      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_45      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_46      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_47      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_48      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_49      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_50      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_51      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_52      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_53      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
recipe_spec_2 <- recipe_spec_1%>%
  update_role(Date,new_role = "ID")

recipe_spec_2 %>% prep() %>% juice() %>% glimpse()
## Rows: 637
## Columns: 83
## $ Date              <date> 2010-02-05, 2010-02-05, 2010-02-05, 2010-02-05, 201…
## $ Weekly_Sales      <dbl> 24924.50, 13740.12, 40129.01, 41969.29, 115564.35, 6…
## $ Date_index.num    <dbl> -1.711776, -1.711776, -1.711776, -1.711776, -1.71177…
## $ Date_year         <dbl> -0.9457415, -0.9457415, -0.9457415, -0.9457415, -0.9…
## $ Date_half         <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Date_quarter      <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Date_month        <int> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2…
## $ Date_mweek        <int> 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3…
## $ Date_week2        <int> 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0…
## $ Date_week3        <int> 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2…
## $ Date_week4        <int> 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0…
## $ id_X1_1           <dbl> 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0…
## $ id_X1_3           <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0…
## $ id_X1_8           <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0…
## $ id_X1_13          <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1…
## $ id_X1_38          <dbl> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0…
## $ id_X1_93          <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0…
## $ id_X1_95          <dbl> 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0…
## $ Date_month.lbl_01 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_02 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Date_month.lbl_03 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_04 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_05 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_06 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_07 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_08 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_09 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_10 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_11 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_month.lbl_12 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_01      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_02      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_03      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_04      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_05      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_06      <dbl> 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_07      <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0…
## $ Date_week_08      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1…
## $ Date_week_09      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_10      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_11      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_12      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_13      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_14      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_15      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_16      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_17      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_18      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_19      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_20      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_21      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_22      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_23      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_24      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_25      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_26      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_27      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_28      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_29      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_30      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_31      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_32      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_33      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_34      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_35      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_36      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_37      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_38      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_39      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_40      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_41      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_42      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_43      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_44      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_45      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_46      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_47      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_48      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_49      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_50      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_51      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_52      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ Date_week_53      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
recipe_spec_1 %>% prep() %>% summary()
## # A tibble: 83 × 4
##    variable       type    role      source  
##    <chr>          <chr>   <chr>     <chr>   
##  1 Date           date    predictor original
##  2 Weekly_Sales   numeric outcome   original
##  3 Date_index.num numeric predictor derived 
##  4 Date_year      numeric predictor derived 
##  5 Date_half      numeric predictor derived 
##  6 Date_quarter   numeric predictor derived 
##  7 Date_month     numeric predictor derived 
##  8 Date_mweek     numeric predictor derived 
##  9 Date_week2     numeric predictor derived 
## 10 Date_week3     numeric predictor derived 
## # … with 73 more rows
recipe_spec_2 %>% prep() %>% summary()
## # A tibble: 83 × 4
##    variable       type    role      source  
##    <chr>          <chr>   <chr>     <chr>   
##  1 Date           date    ID        original
##  2 Weekly_Sales   numeric outcome   original
##  3 Date_index.num numeric predictor derived 
##  4 Date_year      numeric predictor derived 
##  5 Date_half      numeric predictor derived 
##  6 Date_quarter   numeric predictor derived 
##  7 Date_month     numeric predictor derived 
##  8 Date_mweek     numeric predictor derived 
##  9 Date_week2     numeric predictor derived 
## 10 Date_week3     numeric predictor derived 
## # … with 73 more rows

MODELS

prophet

wflw_fit_prophet <- workflow()%>%
  add_model(
    prophet_reg() %>% set_engine("prophet")
  )%>%
  add_recipe(recipe_spec_1)%>%
  fit(training(splits))
## Disabling yearly seasonality. Run prophet with yearly.seasonality=TRUE to override this.
## Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.

XGBOOST

wflw_fit_xgboost <- workflow()%>%
  add_model(
    boost_tree() %>% set_engine("xgboost")
  )%>%
  add_recipe(recipe_spec_2)%>%
  fit(training(splits))

Random Forest

wflw_fit_rf <- workflow()%>%
  add_model(
    rand_forest() %>% set_engine("ranger")
  )%>%
  add_recipe(recipe_spec_2)%>%
  fit(training(splits))

SVM

wflw_fit_svm <- workflow()%>%
  add_model(
    svm_rbf() %>% set_engine("kernlab")
  )%>%
  add_recipe(recipe_spec_2)%>%
  fit(training(splits))

prophet_boost

wflw_fit_prophet_boost <- workflow()%>%
  add_model(
    prophet_boost(
      seasonality_yearly = F,
      seasonality_weekly = F,
      seasonality_daily =  F,
    ) %>% 
      set_engine("prophet_xgboost")
  )%>%
  add_recipe(recipe_spec_1)%>%
  fit(training(splits))

MODELTIME WORKFLOW

modeltime table

submodels_tbl <- modeltime_table(
  wflw_fit_prophet,
  wflw_fit_prophet_boost,
  wflw_fit_xgboost,
  wflw_fit_rf,
  wflw_fit_svm
)

submodels_tbl
## # Modeltime Table
## # A tibble: 5 × 3
##   .model_id .model     .model_desc              
##       <int> <list>     <chr>                    
## 1         1 <workflow> PROPHET W/ REGRESSORS    
## 2         2 <workflow> PROPHET W/ XGBOOST ERRORS
## 3         3 <workflow> XGBOOST                  
## 4         4 <workflow> RANGER                   
## 5         5 <workflow> KERNLAB

calibrate Testing Data

submodels_calibrated_tbl <- submodels_tbl %>%
  modeltime_calibrate(testing(splits))

submodels_calibrated_tbl
## # Modeltime Table
## # A tibble: 5 × 5
##   .model_id .model     .model_desc               .type .calibration_data 
##       <int> <list>     <chr>                     <chr> <list>            
## 1         1 <workflow> PROPHET W/ REGRESSORS     Test  <tibble [364 × 4]>
## 2         2 <workflow> PROPHET W/ XGBOOST ERRORS Test  <tibble [364 × 4]>
## 3         3 <workflow> XGBOOST                   Test  <tibble [364 × 4]>
## 4         4 <workflow> RANGER                    Test  <tibble [364 × 4]>
## 5         5 <workflow> KERNLAB                   Test  <tibble [364 × 4]>

Measure Test Accuracy

submodels_calibrated_tbl%>% modeltime_accuracy()
## # A tibble: 5 × 9
##   .model_id .model_desc               .type   mae  mape  mase smape   rmse   rsq
##       <int> <chr>                     <chr> <dbl> <dbl> <dbl> <dbl>  <dbl> <dbl>
## 1         1 PROPHET W/ REGRESSORS     Test  6350.  15.5 0.189  15.3  8949. 0.945
## 2         2 PROPHET W/ XGBOOST ERRORS Test  5524.  11.0 0.164  11.3  8077. 0.970
## 3         3 XGBOOST                   Test  5321.  10.9 0.158  11.0  7577. 0.971
## 4         4 RANGER                    Test  7902.  25.0 0.235  19.9 10171. 0.969
## 5         5 KERNLAB                   Test  7726.  22.0 0.229  18.7 10351. 0.960

Visualize test forecast

submodels_calibrated_tbl %>%
  modeltime_forecast(
    new_data = testing(splits),
    actual_data = data_prepared_tbl,
    keep_data = T
  )%>%
  group_by(id)%>%
  plot_modeltime_forecast(
    .facet_ncol=2
  )

Refit on full training dataset

submodels_refit_tbl <- submodels_calibrated_tbl %>%
  modeltime_refit(data_prepared_tbl)
## Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.

Visualize Submodel Forecast

submodels_refit_tbl%>%
  modeltime_forecast(
    new_data =  future_tbl,
    actual_data = data_prepared_tbl,
    keep_data = T
  )%>%
  group_by(id) %>%
  plot_modeltime_forecast(
    .facet_ncol=2
  )

ENSEMBLE

Make ensemble

ensemble_fit_mean <- submodels_tbl %>%
  filter(!.model_id %in% c(1))%>%
  ensemble_average(type="mean")

# Modeltime table
ensemble_tbl <- modeltime_table(
  ensemble_fit_mean
)

ensemble_tbl
## # Modeltime Table
## # A tibble: 1 × 3
##   .model_id .model         .model_desc              
##       <int> <list>         <chr>                    
## 1         1 <ensemble [4]> ENSEMBLE (MEAN): 4 MODELS

Ensemble test Accuracy

ensemble_tbl%>%
  combine_modeltime_tables(submodels_tbl)%>%
  modeltime_accuracy(testing(splits))
## # A tibble: 6 × 9
##   .model_id .model_desc               .type   mae  mape  mase smape   rmse   rsq
##       <int> <chr>                     <chr> <dbl> <dbl> <dbl> <dbl>  <dbl> <dbl>
## 1         1 ENSEMBLE (MEAN): 4 MODELS Test  6183.  15.7 0.184  14.3  8540. 0.973
## 2         2 PROPHET W/ REGRESSORS     Test  6350.  15.5 0.189  15.3  8949. 0.945
## 3         3 PROPHET W/ XGBOOST ERRORS Test  5524.  11.0 0.164  11.3  8077. 0.970
## 4         4 XGBOOST                   Test  5321.  10.9 0.158  11.0  7577. 0.971
## 5         5 RANGER                    Test  7902.  25.0 0.235  19.9 10171. 0.969
## 6         6 KERNLAB                   Test  7726.  22.0 0.229  18.7 10351. 0.960

Ensemble Test Forecast

ensemble_tbl%>%
  modeltime_forecast(
    new_data =  testing(splits),
    actual_data = data_prepared_tbl,
    keep_data = T
  )%>%
  group_by(id) %>%
  plot_modeltime_forecast(
    .facet_ncol=2
  )
## Warning: Expecting the following names to be in the data frame: .conf_hi, .conf_lo. 
## Proceeding with '.conf_interval_show = FALSE' to visualize the forecast without confidence intervals.
## Alternatively, try using `modeltime_calibrate()` before forecasting to add confidence intervals.

Refit Ensemble

ensemble_refit_tbl <- ensemble_tbl%>%
  modeltime_refit(data_prepared_tbl)

Visualize Ensemble Forecast

ensemble_refit_tbl%>%
  modeltime_forecast(
    new_data =  future_tbl,
    actual_data = data_prepared_tbl,
    keep_data = T
  )%>%
  group_by(id) %>%
  plot_modeltime_forecast(
    .facet_ncol=2
  )
## Warning: Expecting the following names to be in the data frame: .conf_hi, .conf_lo. 
## Proceeding with '.conf_interval_show = FALSE' to visualize the forecast without confidence intervals.
## Alternatively, try using `modeltime_calibrate()` before forecasting to add confidence intervals.